home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / msword1a / convhtml.bas next >
BASIC Source File  |  1999-08-27  |  2KB  |  67 lines
  1. Attribute VB_Name = "ConvHTML"
  2. Option Explicit
  3. ' ConvHTML.bas Mar, 1999 contact markb@orionstudios.com
  4. ' Function to save a Word Document as HTML programmatically
  5. ' Includes workaround for problem discussed in KB Q162132 (see below)
  6. ' ====================================================================
  7.  
  8. Public Function SaveDocAsHTML( _
  9.                 Doc As Word.Document, _
  10.                 NewFileName As String) As String
  11. '
  12. ' Returns full path\name of saved file
  13. '
  14.     On Error GoTo SaveDocAsHTML_Error
  15.     
  16.     Dim Result As String ' default function result = ""
  17.     Dim wrdApp As Word.Application
  18.     Dim lngSaveFormat As Long
  19.     
  20.     Set wrdApp = Doc.Application
  21.     lngSaveFormat = GetHTMLSaveFormat(WordApp:=wrdApp)
  22.     If lngSaveFormat Then   ' File Converter for HTML is available for Save
  23.         Doc.SaveAs FileFormat:=lngSaveFormat, FileName:=NewFileName
  24.         With wrdApp.ActiveDocument
  25.             Result = .Path & "\" & .Name
  26.         End With
  27.     End If
  28.     
  29. SaveDocAsHTML_Exit:
  30.     SaveDocAsHTML = Result
  31.     Exit Function
  32.     
  33. SaveDocAsHTML_Error:
  34.     MsgBox Err.Number & " - " & Err.Description, vbExclamation, "SaveDocAsHTML"
  35.     Resume SaveDocAsHTML_Exit
  36.     
  37. End Function
  38.  
  39. Private Function GetHTMLSaveFormat(WordApp As Word.Application) As Long
  40. '
  41. ' KB Article Q162132 - WD97: Run-time error '5880' Saving as HTML from VBA
  42. '
  43. ' Problem occurs when accessing the "HTML" document format
  44. ' from the FileConverters collection using a string value
  45. ' instead of a numerical value for the index.
  46. '
  47.     On Error GoTo GetHTMLSaveFormat_Exit
  48.     
  49.     Dim Result As Long  ' default function result = 0
  50.     Dim wrdFileConverter As Word.FileConverter
  51.     
  52.     For Each wrdFileConverter In WordApp.FileConverters
  53.         If wrdFileConverter.ClassName = "HTML" Then
  54.             With wrdFileConverter
  55.                 If .CanSave Then
  56.                     Result = .SaveFormat
  57.                 End If
  58.             End With
  59.             Exit For
  60.         End If
  61.     Next wrdFileConverter
  62.     
  63. GetHTMLSaveFormat_Exit:
  64.     GetHTMLSaveFormat = Result
  65.     
  66. End Function
  67.